##
## Commands / Functions that deal with building.

package Purl::Commands::building;
use constant NONE => -1;

sub import {

    #
    #    Purl::Commands::register(
    #        name   => "\@set",
    #        subRef => \&Purl::Commands::building::set,
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@link",
    #        subRef => \&Purl::Commands::building::cmd_link,
    #    );
    #    Purl::Commands::register(
    #        name   => "\@tel",
    #        subRef => \&Purl::Commands::building::teleport,
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@teleport",
    #        subRef => \&Purl::Commands::building::teleport,
    #    );
    #    Purl::Commands::register(
    #        name   => "\@doing",
    #        subRef => \&Purl::Commands::building::doing,
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@open",
    #        subRef => \&Purl::Commands::building::cmd_open
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@pcreate",
    #        subRef => \&Purl::Commands::building::cmd_pcreate
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@dig",
    #        subRef => \&Purl::Commands::building::cmd_dig
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@create",
    #        subRef => \&Purl::Commands::building::cmd_create
    #    );
    #
    #    Purl::Commands::register(
    #        name   => "\@gag",
    #        subRef => \&Purl::Commands::building::cmd_gag
    #    );
    #    Purl::Commands::register(
    #        name   => "\@ungag",
    #        subRef => \&Purl::Commands::building::cmd_ungag
    #    );
    #    Purl::Commands::register(
    #        name   => "\@recycle",
    #        subRef => \&Purl::Commands::building::recycle
    #    );
    #    Purl::Commands::register(
    #        name   => "\@toad",
    #        subRef => \&Purl::Commands::building::toad
    #    );
    Purl::Commands::register(
        name                  => "look",
        subRef                => \&Purl::Commands::building::look,
        aliases               => "l",
        shortCommandException => TRUE
    );

    Purl::Commands::register(
        name                  => "examine",
        subRef                => \&Purl::Commands::building::examine,
        shortCommandException => TRUE,
        aliases               => "exa ex"
    );

}

## DB Access Functions

sub owner {
    my $dbref = shift;
    return $main::objects[$dbref]{"owner"};

}

## Building Commands

sub cmd_link {
    %args = @_;
    if ( !&Purl::tests::isBuilder($me) ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "Sorry, only an authorized builder can do that."
        );
        return;
    }
    if ( $arg2 eq "" ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "Syntax: \@link person/thing = #place"
        );
        return;
    }
    $_ = $arg2;
    my ($id);
    if ( substr( $arg1, 0, 1 ) ne "#" ) {
        $id = &findContents( $main::objects[$me]{"location"}, $arg1 );
        $id = &findContents( $me, $arg1 ) if ( $id == NONE );
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "I don't see that here."
        );
        return;
    }
    if (   ( $main::objects[$id]{"owner"} != $me )
        && ( !&Purl::tests::isWizard($me) ) )
    {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "You don't own that."
        );
        return;
    }
    my $arg2id = NONE;
    if ( $main::objects[$id]{"type"} == $exit ) {
        if ( ( $arg2 eq "nowhere" ) || ( $arg2 eq "NOWHERE" ) ) {
            $arg2id = $nowhere;
        }
        elsif ( ( $arg2 eq "home" ) || ( $arg2 eq "HOME" ) ) {
            $arg2id = $home;
        }
    }
    if ( $arg2id == NONE ) {
        if ( substr( $arg2, 0, 1 ) ne "#" ) {
            Purl::comm::sendTextToPlayer(
                target => $me,
                text   => "Syntax: \@link person/thing = #place"
            );
            return;
        }
        $arg2id = substr( $arg2, 1 );
        $arg2id = &main::idBounds($arg2id);
    }
    if ( $main::objects[$id]{"type"} == $exit ) {

        # Special case for 'nowhere' and 'home'
        if ( ( $arg2id == $nowhere ) || ( $arg2id == $home ) ) {
            $main::objects[$id]{"action"} = $arg2id;
            Purl::comm::sendTextToPlayer(
                target => $me,
                text   => "Destination set."
            );
            return;
        }
    }
    if ( $arg2id == NONE ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "That destination id is not valid."
        );
        return;
    }
    if ( $main::objects[$arg2id]{"type"} != $room ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "That is not a valid destination."
        );
        return;
    }
    if (   ( $main::objects[$id]{"type"} != $player )
        && ( $main::objects[$id]{"type"} != $thing )
        && ( $main::objects[$id]{"type"} != $exit ) )
    {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "You can't link that."
        );
        return;
    }
    if ( $main::objects[$id]{"type"} == $exit ) {
        if ((   !(  $main::objects[$arg2id]{"flags"}
                    & $flags{"linkok"}{"value"}
                )
            )
            && ( !( $main::objects[$arg2id]{"owner"} == $me ) )
            && ( !&Purl::tests::isWizard($me) )
            )
        {
            Purl::comm::sendTextToPlayer(
                target => $me,
                text => "That destination does not have its linkok flag set."
            );
        }
        else {
            $main::objects[$id]{"action"} = $arg2id;
            Purl::comm::sendTextToPlayer(
                target => $me,
                text   => "Destination set."
            );
        }
    }
    else {
        if ((   !(  $main::objects[$arg2id]{"flags"}
                    & $flags{"abode"}{"value"}
                )
            )
            && ( !( $main::objects[$arg2id]{"owner"} == $me ) )
            && ( !&Purl::tests::isWizard($me) )
            )
        {
            Purl::comm::sendTextToPlayer(
                target => $me,
                text   => "That location does not have its abode flag set."
            );
        }
        else {
            $main::objects[$id]{"home"} = $arg2id;
            Purl::comm::sendTextToPlayer(
                target => $me,
                text   => "Home set."
            );
        }
    }
}

sub cmd_open {
    %args = @_;

    if ( !&Purl::tests::isBuilder($me) ) {
        Purl::comm::sendTextToPlayer(
            target => $me,
            text   => "Sorry, only an authorized builder can do that."
        );
        return;
    }
    if ( ( $main::objects[ $main::objects[$me]{"location"} ]{"owner"} != $me )
        && ( !&Purl::tests::isWizard($me) ) )
    {
        if (!(  $main::objects[ $main::objects[$me]{"location"} ]{"flags"}
                & $flags{"buildok"}{"value"}
            )
            )
        {
            Purl::comm::sendTextToPlayer( $me,
                "This location is not set buildok." );
            return;
        }
    }
    $arg1 =~ s/\s+;/;/g;
    $arg1 =~ s/;\s+/;/g;
    if ( $arg2 eq "" ) {
        Purl::comm::sendTextToPlayer( $me,
            "Syntax: \@open direction;synonym = #destid" );
    }
    else {
        $_    = $arg2;
        $arg2 = "#" . $nowhere if ( $arg2 eq "nowhere" );
        $arg2 = "#" . $home if ( $arg2 eq "home" );
        if ( substr( $arg2, 0, 1 ) ne "#" ) {
            Purl::comm::sendTextToPlayer( $me,
                "Syntax: \@open direction;synonym = #destid (note the # sign)"
            );
        }
        else {
            $arg2 = substr( $arg2, 1 );
            if ( ( $arg2 == $home ) || ( $arg2 == $nowhere ) ) {
                my $id = &addObject( $me, $arg1, $exit );
                &addContents( $main::objects[$me]{"location"}, $id );
                $main::objects[$id]{"action"} = $arg2;
                Purl::comm::sendTextToPlayer( $me, "Opened." );
                return;
            }
            $arg2 = &main::idBounds($arg2);
            if (   ( $arg2 == NONE )
                || ( $main::objects[$arg2]{"type"} != $room ) )
            {
                Purl::comm::sendTextToPlayer( $me,
                    "That destination id is not valid." );
                return;
            }
            if (   ( $main::objects[$arg2]{"owner"} != $me )
                && ( !&Purl::tests::isWizard($me) ) )
            {
                if (!(  $main::objects[$arg2]{"flags"}
                        & $flags{"linkok"}{"value"}
                    )
                    )
                {
                    Purl::comm::sendTextToPlayer( $me,
                        "That destination does not have its linkok flag set."
                    );
                    return;
                }
            }
            my $id = &addObject( $me, $arg1, $exit );
            &addContents( $main::objects[$me]{"location"}, $id );
            $main::objects[$id]{"action"} = $arg2;
            $main::objects[$id]{"home"}   = $main::objects[$me]{"location"};
            Purl::comm::sendTextToPlayer( $me, "Opened." );
        }
    }
}

sub cmd_pcreate {
    %args = @_;
    ( $arg1, $arg2 ) = split( /=/, $arg, 2 );
    if ( !&Purl::tests::isWizard($me) ) {
        Purl::comm::sendTextToPlayer( $me,
            "Sorry, only a wizard can do that." );
        return;
    }
    if ( ( $arg1 eq "" ) || ( $arg2 eq "" ) ) {
        Purl::comm::sendTextToPlayer( $me,
            "Syntax: \@pcreate <name> = <password>" );
        return;
    }
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        Purl::comm::sendTextToPlayer( $me,
            "Sorry, names cannot begin with #." );
        return;
    }
    $_ = $arg1;
    if (/\s/) {
        Purl::comm::sendTextToPlayer( $me,
            "Sorry, names cannot contain spaces." );
        return;
    }
    my $n = $arg1;
    $n =~ tr/A-Z/a-z/;
    if ( exists( $main::playerIds{$n} ) ) {
        Purl::comm::sendTextToPlayer( $me, "Sorry, that name is taken." );
        return;
    }
    my $id = &main::addObject( $me, $arg1, $player );
    $main::playerIds{$n} = $id;
    $main::objects[$id]{"owner"} = $id;
    &main::addContents( 0, $id );
    $main::objects[$id]{"password"} = main::md5_base64($arg2);
    if ($main::allowBuild) {
        $main::objects[$id]{"flags"} = $main::flags{"builder"}{"value"};
    }
    else {
        $main::objects[$id]{"flags"} = 0;
    }
}

sub cmd_dig {
    %args = @_;
    if ( !&Purl::tests::isBuilder( $args{actor} ) ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "Sorry, only an authorized builder can do that."
        );
        return;
    }
    &Purl::database::addObject( $args{actor}, $arg, $room );
}

sub cmd_create {
    %args = @_;
    my ($id);
    if ( !&Purl::tests::isBuilder( $args{actor} ) ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "Sorry, only an authorized builder can do that."
        );
        return;
    }
    if ( $args{text} =~ /^\s*$/ ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Syntax: \@create nameofthing" );
        return;
    }
    $id = &Purl::database::addObject( $args{actor}, $arg, $thing );
    &main::addContents( $args{actor}, $id );
    $main::objects[$id]{"home"} = $main::objects[ $args{actor} ]{"home"};
}

## Object Commands

sub addObject {
    my ( $maker, $name, $type ) = @_;
    my ( $id, $found );
    $found = 0;
    for ( $id = 0; ( $id <= $#objects ); $id++ ) {
        if ( $main::objects[$id]{"type"} == NONE ) {
            $found = 1;
            last;
        }
    }
    $id = $#objects + 1 if ( !$found );
    $main::objects[$id]{"name"}     = $name;
    $main::objects[$id]{"type"}     = $type;
    $main::objects[$id]{"activeFd"} = NONE;
    $main::objects[$id]{"owner"}    = $maker;
    Purl::comm::sendTextToPlayer( $maker,
        $main::objects[$id]{"name"} . " has been created as #" . $id . "." )
        if ( $maker != 0 );
    return $id;
}

sub addContents {
    my ( $addto, $add ) = @_;

    # Whatever you do, don't let any commas get in here
    $add =~ s/,//g;

    if ( length( $main::objects[$addto]{"contents"} ) > 0 ) {
        $main::objects[$addto]{"contents"} .= "," . $add;
    }
    else {
        $main::objects[$addto]{"contents"} = $add;
    }
    $main::objects[$add]{"location"} = $addto;
}

sub findContents {
    my ( $container, $arg, $type ) = @_;
    my (@list);
    $args{text} =~ tr/A-Z/a-z/;
    @list = split( /,/, $main::objects[$container]{"contents"} );
    my ($e);
    if ( substr( $arg, 0, 1 ) eq "#" ) {
        foreach $e (@list) {
            if ( ( "#" . $e ) eq $arg ) {
                return $e
                    if ( ( !$type )
                    || ( $main::objects[$e]{"type"} == $type ) );
            }
        }
        return NONE;
    }

    #First an exact match
    foreach $e (@list) {
        my $name = $main::objects[$e]{"name"};
        $name =~ tr/A-Z/a-z/;
        if ( $name eq $arg ) {
            return $e
                if ( ( !$type ) || ( $main::objects[$e]{"type"} == $type ) );
        }

        #TinyMUD semicolon stuff
        if ( $main::objects[$e]{"type"} == $exit ) {
            my @elist = split( /;/, $main::objects[$e]{"name"} );
            foreach my $f (@elist) {
                $f =~ tr/A-Z/a-z/;
                if ( $f eq $arg ) {
                    return $e
                        if ( ( !$type )
                        || ( $main::objects[$e]{"type"} == $type ) );
                }
            }
        }
    }

    #Okay, now an inexact match
    foreach $e (@list) {
        my $name = $main::objects[$e]{"name"};
        $name =~ tr/A-Z/a-z/;
        if ( substr( $name, 0, length($arg) ) eq $arg ) {
            return $e
                if ( ( !$type ) || ( $main::objects[$e]{"type"} == $type ) );
        }

        #TinyMUD semicolon stuff
        if ( $main::objects[$e]{"type"} == $exit ) {
            my @elist = split( /;/, $main::objects[$e]{"name"} );
            foreach my $f (@elist) {
                $f =~ tr/A-Z/a-z/;
                if ( substr( $f, 0, length($arg) ) eq $arg ) {
                    return $e
                        if ( ( !$type )
                        || ( $main::objects[$e]{"type"} == $type ) );
                }
            }
        }
    }
    return NONE;
}

sub removeContents {
    my ( $container, $id ) = @_;
    my @list = split( /,/, $main::objects[$container]{"contents"} );
    $main::objects[$container]{"contents"} = "";
    foreach my $e (@list) {
        &addContents( $container, $e ) if ( $e ne $id );
    }
}

sub describe {
    my %args = @_;

    #  print
    "DEBUG: describe - $args{actor} - $args{text} - $args{target} - $args{details}\n";

    my $return = describeBody(@_);
    Purl::comm::sendTextToPlayer( target => $args{actor}, text => $return );

}

sub parseFlagLetters {
    my $dbref      = shift;
    my $flagString = "";
    my %typeAbbrv = ( "player", "P", "thing", "T", "exit", "E", "room", "R" );
    foreach my $type ( keys %typeAbbrv ) {
        $flagString .= $typeAbbrv{$type}
            if ( $main::objects[$dbref]{"type"} == ${$type} );
    }
    foreach my $flag ( keys %flags ) {
        $flagString .= $flags{$flag}{"symbol"}
            if ( $main::objects[$dbref]{"flags"} & $flags{$flag}{"value"} );
    }
    return $flagString;
}

sub describeBody {
    my $args   = @_;
    my $found  = 0;
    my $return = "";

    #   print
    "DEBUG: describeBody - $args{actor} - $args{text} - $args{target} - $args{details}\n";

    if ( $args{details} ) {
        my $line = parseNameDbref( $args{to}, $args{target} )
            . "\nOwner: "
            . $main::objects[ $main::objects[ $args{target} ]{"owner"} ]
            {"name"}
            . " Home: #"
            . int( $main::objects[ $args{target} ]{"home"} );
        my ( $key, $val );
        while ( $key = each(%main::flags) ) {
            if ( $main::objects[ $args{target} ]{"flags"}
                & $main::flags{$key}{"value"} )
            {
                $line .= " " . $key;
            }
        }
        $return .= $line . "\n";
        if ( $main::objects[ $args{target} ]{"type"} == $main::player ) {
            my ($tz) = $main::objects[ $args{target} ]{"tz"};
            if ( $tz eq "" ) {
                $return .= "Time Zone: Not Set\n";
            }
            else {
                my ($prefix) = "";
                if ( $tz < 0 ) {
                    $tz     = -$tz;
                    $prefix = "-";
                }
                my ( $hours, $mins ) = ( int( $tz / 60 ), $tz % 60 );
                $return .= "Time Zone: "
                    . sprintf( "%s%02d:%02d", $prefix, $hours, $mins ) . "\n";
            }
        }
        if ( &Purl::tests::isWizard( $args{to} )
            || ( $main::objects[ $args{target} ]{"owner"} == $args{to} ) )
        {
            $return
                .= "Fail: " . $main::objects[ $args{target} ]{"fail"} . "\n"
                if ( $main::objects[ $args{target} ]{"fail"} ne "" );
            $return
                .= "Ofail: " . $main::objects[ $args{target} ]{"ofail"} . "\n"
                if ( $main::objects[ $args{target} ]{"ofail"} ne "" );
            $return
                .= "Odrop: " . $main::objects[ $args{target} ]{"odrop"} . "\n"
                if ( $main::objects[ $args{target} ]{"odrop"} ne "" );
            $return .= "Success: "
                . $main::objects[ $args{target} ]{"success"} . "\n"
                if ( $main::objects[ $args{target} ]{"success"} ne "" );
            $return .= "Osuccess: "
                . $main::objects[ $args{target} ]{"osuccess"} . "\n"
                if ( $main::objects[ $args{target} ]{"osuccess"} ne "" );
            $return
                .= "Lock: " . $main::objects[ $args{target} ]{"lock"} . "\n"
                if ( $main::objects[ $args{target} ]{"lock"} ne "" );
            $return
                .= "Gags: " . $main::objects[ $args{target} ]{"gags"} . "\n"
                if ( $main::objects[ $args{target} ]{"gags"} ne "" );
            $return .= "Site/IP: "
                . $main::objects[ $args{target} ]{"site"} . "/"
                . $main::objects[ $args{target} ]{"ip"} . "\n"
                if ( $main::objects[ $args{target} ]{"ip"} ne "" );
        }
        $return .= "Location: #"
            . int( $main::objects[ $args{target} ]{"location"} ) . "\n";
        if ( &Purl::tests::isWizard( $args{to} )
            || ( $main::objects[ $args{target} ]{"owner"} == $args{to} ) )
        {
            if ( $main::objects[ $args{target} ]{"type"} == $exit ) {
                my $dest = int( $main::objects[ $args{target} ]{"action"} );
                if ( $dest == $nowhere ) {
                    $return .= "Destination: nowhere" . "\n";
                }
                elsif ( $dest == $home ) {
                    $return .= "Destination: home" . "\n";
                }
                else {
                    $return .= "Destination: #"
                        . int( $main::objects[ $args{target} ]{"action"} )
                        . "\n";
                }
            }
        }
    }
    else {
        $return .= $main::objects[ $args{target} ]{"name"} . "\n"
            if ( $main::objects[ $args{target} ]{"type"} != $exit );
    }
    if ( $main::objects[ $args{target} ]{"description"} eq "" ) {
        $return .= "You see nothing special." . "\n";
    }
    else {
        $return .= $main::objects[ $args{target} ]{"description"} . "\n";
    }
    my ( @list, $desc, $first, $e );
    @list  = split( /,/, $main::objects[ $args{target} ]{"contents"} );
    $desc  = "";
    $first = 1;
    if ($details
        || (!(  $main::objects[ $args{target} ]{"flags"}
                & $flags{"dark"}{"value"}
            )
        )
        )
    {
        foreach $e (@list) {
            if ($details) {
                $found = 1;
                if ($first) {
                    $first = 0;
                }
                else {
                    $desc .= ", ";
                }
                $desc .= $main::objects[$e]{"name"} . " #" . $e;
            }
            else {
                if (( $main::objects[$e]{"type"} == $thing )
                    || (   ( $main::objects[$e]{"type"} == $player )
                        && ( $main::objects[$e]{"activeFd"} ne NONE ) )
                    )
                {
                    $found = 1;
                    if ($first) {
                        $first = 0;
                        $desc .= $main::objects[$e]{"name"};
                    }
                    else {
                        $desc .= ", " . $main::objects[$e]{"name"};
                    }
                }
            }
        }
    }
    if ( !$found ) {
        if ( $main::objects[ $args{target} ]{"type"} == $main::room ) {
            if ($details
                || (!(  $main::objects[ $args{target} ]{"flags"}
                        & $flags{"dark"}{"value"}
                    )
                )
                )
            {
                $return .= "Contents: None" . "\n";
            }
        }
    }
    else {
        if ( $main::objects[ $args{target} ]{"type"} == $main::player ) {
            $return .= "Carrying:" . "\n";
        }
        else {
            $return .= "Contents:" . "\n";
        }
        $return .= $desc . "\n";
    }
    $first = 1;
    $desc  = "";
    $found = 0;
    if (   ( $main::objects[ $args{target} ]{"type"} == $main::room )
        && ( !$details ) )
    {
        foreach $e (@list) {
            $found = 1;
            if ( !$details ) {
                if (( $main::objects[$e]{"type"} == $main::exit )
                    && (!(  $main::objects[$e]{"flags"}
                            & $flags{"dark"}{"value"}
                        )
                    )
                    )
                {
                    if ($first) {
                        $first = 0;
                    }
                    else {
                        $desc .= ", ";
                    }
                    my (@foo) = split( /;/, $main::objects[$e]{"name"} );
                    $desc .= "\x01" . $foo[0] . "," . $foo[0] . "\x02";
                }
            }
        }
        if ( !$found ) {
            $return .= "Visible Exits: None" . "\n";
        }
        else {
            $return .= "Visible Exits:" . "\n";
            $return .= $desc . "\n";
        }
    }
    $found = 0;
    $first = 1;
    $desc  = "";

    #   print "DEBUG:$return\n";
    return $return;

}

sub cmd_gag {
    %args = @_;
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Syntax: \@gag name" );
        return;
    }
    if ( $args{text} =~ / / ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "PurlMUSH user names do not contain spaces." );
        return;
    }

    # Allow big-geek syntax
    if ( $args{text} =~ /^#(\d+)$/ ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "That player does not exist." )
            if ( !defined( $main::objects[$1] ) );
        Purl::comm::sendTextToPlayer( $args{actor},
            "Only players can be gagged." )
            if ( $main::objects[$1]{"type"} != $player );

        # Okay, now we can accept it.
        $args{text} = $main::objects[$1]{"name"};
    }

    # Strip a leading *, the global player reference thingie,
    # not required here but allowed.
    if ( $args{text} =~ /^\*(\w+)$/ ) {
        $args{text} = $1;
    }

    # Look up the player. Do they exist?
    my ($copy) = $arg;
    $copy =~ tr/A-Z/a-z/;
    if ( !exists( $main::playerIds{$copy} ) ) {

        # Break the bad news
        Purl::comm::sendTextToPlayer( $args{actor},
            "There is no player by that name." );
        return;
    }

    # Check whether that player is already gagged
    $args{text} = quotemeta($arg);
    if ( $main::objects[ $args{actor} ]{"gags"} =~ /$args{text}/i ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Already gagged." );
        return;
    }

    # Now we're ready to gag! Great!
    # Be sure to use the proper name to get the right case.
    $main::objects[ $args{actor} ]{"gags"}
        .= $main::objects[ $main::playerIds{$copy} ]{"name"} . " ";
    Purl::comm::sendTextToPlayer( $args{actor}, "Gag in place." );
}

sub cmd_ungag {
    %args = @_;
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Syntax: \@ungag name" );
        return;
    }
    if ( $args{text} =~ / / ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "PurlMUSH user names do not contain spaces." );
        return;
    }

    # Allow big-geek syntax
    if ( $args{text} =~ /^#(\d+)$/ ) {
        if ( !defined( $main::objects[$1] ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That player does not exist." );
        }
        if ( $main::objects[$1]{"type"} != $player ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "Only players can be gagged." );
        }

        # Okay, now we can accept it.
        $args{text} = $main::objects[$1]{"name"};
    }

    # Strip a leading *, the global player reference thingie,
    # not required here but allowed.
    if ( $args{text} =~ /^\*(\w+)$/ ) {
        $args{text} = $1;
    }

    # We don't care whther the player exists -- removing
    # a gag for a now-main::nonexistent player is pretty common!

    # Check whether that player is gagged.
    $args{text} = quotemeta($arg);
    if ( $main::objects[ $args{actor} ]{"gags"} =~ /$args{text} /i ) {

        # Remove the gag of that player.
        $main::objects[ $args{actor} ]{"gags"} =~ s/$args{text} //i;
        Purl::comm::sendTextToPlayer( $args{actor}, "Gag removed." );
        return;
    }

    # No such gag.
    Purl::comm::sendTextToPlayer( $args{actor},
        "That player is not gagged, or you mistyped their name." );
}

sub clean {
    %args = @_;
    if ( $args{text} ne "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "\@clean takes no arguments." );
        return;
    }
    my ( @list, $e );
    @list = split( /,/,
        $main::objects[ $main::objects[ $args{actor} ]{"location"} ]
            {"contents"} );
    if ((   $main::objects[ $main::objects[ $args{actor} ]{"location"} ]
            {"owner"} != $args{actor}
        )
        && ( !&Purl::tests::isWizard( $args{actor} ) )
        )
    {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You can only \@clean locations you own." );
        return;
    }
    foreach $e (@list) {
        if ( $main::objects[$e]{"home"}
            != $main::objects[ $args{actor} ]{"location"} )
        {
            next
                if ( $main::objects[$e]{"activeFd"} != NONE )
                ;    # Leave conscious objects alone
            &sendHome($e) if ( $main::objects[$e]{"type"} != $exit );
        }
    }
}

sub teleport {
    %args = @_;
    if ( $arg2 eq "" ) {
        if ( $arg1 ne "" ) {
            $arg2 = $arg1;
            $arg1 = "#" . $args{actor};
        }
        else {
            Purl::comm::sendTextToPlayer( $args{actor},
                "Syntax: \@teleport thing = #place" );
            return;
        }
    }
    if ( substr( $arg2, 0, 1 ) ne "#" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Syntax: \@teleport thing = #place" );
        return;
    }
    my ($id);
    if ( !( substr( $arg1, 0, 1 ) eq "#" ) ) {
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 );
        $id = &findContents( $args{actor}, $arg1 ) if ( $id == NONE );
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    my ($arg2id) = substr( $arg2, 1 );
    if (   ( $main::objects[$id]{"type"} != $player )
        && ( $main::objects[$id]{"type"} != $thing )
        && ( $main::objects[$id]{"type"} != $exit ) )
    {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You can't teleport that." );
        return;
    }
    if (   ( $main::objects[$id]{"owner"} != $args{actor} )
        && ( !&Purl::tests::isWizard( $args{actor} ) ) )
    {
        if ( !( $main::objects[$id]{"flags"} & $flags{"jumpok"}{"value"} ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That object is not set jumpok." );
            return;
        }
    }
    if ( $arg2id == $home ) {
        &sendHome($id);
        Purl::comm::sendTextToPlayer( $args{actor}, "Teleported." );
        return;
    }
    $id = &main::idBounds($id);
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "That destination id is not valid." );
        return;
    }
    if ( $main::objects[$arg2id]{"type"} != $room ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "That is not a valid destination." );
        return;
    }
    if (   ( $main::objects[$arg2id]{"owner"} != $args{actor} )
        && ( !&Purl::tests::isWizard( $args{actor} ) ) )
    {
        if ( !( $main::objects[$arg2id]{"flags"} & $flags{"jumpok"}{"value"} )
            )
        {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That destination is not set jumpok." );
            return;
        }
    }
    &dropAll( $args{actor} )
        if (
        $main::objects[ $main::objects[ $args{actor} ]{"location"} ]{"flags"}
        & $flags{"puzzle"}{"value"} );
    my ($oldLocation) = $main::objects[$id]{"location"};
    &removeContents( $main::objects[$id]{"location"}, $id );
    &tellRoom( $main::objects[$id]{"location"},
        NONE, $main::objects[$id]{"name"} . " disappears." );
    &tellRoom( $arg2id, NONE,
        $main::objects[$id]{"name"} . " materializes." );
    &addContents( $arg2id, $id );
    &describe( $id, $arg2id, 0 );
    Purl::comm::sendTextToPlayer( $id,
              $main::objects[ $args{actor} ]{"name"}
            . " has teleported you to "
            . $main::objects[$arg2id]{"name"}
            . "." )
        if ( $args{actor} != $id );
    Purl::comm::sendTextToPlayer( $args{actor}, "Teleported." );
}

sub password {
    %args = @_;
    if ( $arg2 eq "" ) {
        if ( $arg1 eq "" ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "Syntax: \@password <name> = <password> or \@password <newpassword>"
            );
            return;
        }
        $arg2 = $arg1;
        $arg1 = "#" . $args{actor};
    }
    my $n = $arg1;
    $n =~ tr/A-Z/a-z/;
    my ($id);
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    else {
        if ( !exists( $main::playerIds{$n} ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "There is no such player." );
            return;
        }
        $id = $main::playerIds{$n};
    }
    if (   ( $id != $args{actor} )
        && ( !&Purl::tests::isWizard( $args{actor} ) ) )
    {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Sorry, you can't do that." );
        return;
    }
    if ( $main::objects[$id]{"type"} != $player ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "That is not a player!" );
        return;
    }
    $main::objects[$id]{"password"} = main::md5_base64($arg2);
    Purl::comm::sendTextToPlayer( $args{actor}, "Password changed." );
}

sub look {
    %args = @_;
    if ( $args{text} eq "me" ) {
        $args{text}   = "#" . $args{actor};
        $args{target} = "#" . $args{actor};
    }

    #   print "DEBUG: $args{actor} - $args{text} - $args{target}\n";
    &lookBody(%args);
}

sub examine {
    %args = @_;
            Purl::comm::sendTextToPlayer(    
            target => $args{actor},
            text   => "$main::objects[$args{text}]{name}(#$args{text})"
        );
    foreach $attr ( keys %{ $main::objects[ $args{text} ] } ) {
     next if ($attr eq "name");
        Purl::comm::sendTextToPlayer(    
            target => $args{actor},
            text   => sprintf ("%s: %s", $attr, $main::objects[$args{text}]{$attr})
        );
    }
}

sub find {
    my %args = @_;
    my ( $i, $id, $len1, $len2, $w, $found, $name );
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "Syntax: \@find name"
        );
        return;
    }
    $args{text} =~ tr/A-Z/a-z/;
    $found = 0;
    $len1  = length($arg);
    $w     = &Purl::tests::isWizard( $args{actor} );
    for ( $i = 0; ( $i <= $#objects ); $i++ ) {
        if ( $w || ( $main::objects[$i]{"owner"} == $args{actor} ) ) {
            ( $name = $main::objects[$i]{"name"} ) =~ tr/A-Z/a-z/;
            $len2 = length($name);
            if ( $len1 <= $len2 ) {
                if ( substr( $name, 0, $len1 ) eq $arg ) {
                    Purl::comm::sendTextToPlayer( $args{actor},
                        "#" . $i . ": " . $main::objects[$i]{"name"} );
                    $found = 1;
                }
            }
        }
    }
    Purl::comm::sendTextToPlayer( $args{actor}, "Not found." ) if ( !$found );
}

sub stats {
    my %args = @_;
    my ( $i, $j, @typeCounts, @flagCounts, $open, $owner, $total );
    $owner = NONE;
    if ( $args{text} ne "" ) {
        if ( substr( $arg, 0, 1 ) ne "#" ) {
            my ($n);
            $n = $arg1;
            $n =~ tr/A-Z/a-z/;
            if ( !exists( $main::playerIds{$n} ) ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "There is no such player." );
                return;
            }
            $owner = $main::playerIds{$n};
        }
        else {
            $owner = substr( $arg, 1 );
            $owner = &main::idBounds($owner);
        }
        if ( $owner == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That is not a valid player." );
            return;
        }
        if ( $main::objects[$owner]{"type"} != $player ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That is not a valid player." );
            return;
        }
    }
    for ( $i = 0; ( $i <= $#objects ); $i++ ) {
        if ( $owner != NONE ) {
            next if ( $main::objects[$i]{"owner"} != $owner );
        }
        if ( $main::objects[$i]{"type"} == NONE ) {
            $open++;
        }
        else {
            $typeCounts[ $main::objects[$i]{"type"} ]++;
        }

        #for ($j = 0; ($j <= $#flagNames); $j++) {
        #	$flagCounts[$j]++ if ($main::objects[$i]{"flags"} & (1 << $j));
        #}
        $total++;
    }
    if ( $owner == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Overall Statistics" );
    }
    else {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Statistics for " . $main::objects[$owner]{"name"} );
    }
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total objects:           " . int($total) );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total things:            " . int( $typeCounts[$thing] ) );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total exits:             " . int( $typeCounts[$exit] ) );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total rooms:             " . int( $typeCounts[$room] ) );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total players:           " . int( $typeCounts[$player] ) );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Total unused objects:    " . $open )
        if ( $owner == NONE );

#for ($i = 0; ($i <= $#flagNames); $i++) {
#	if ($flagCounts[$i]) {
#		Purl::comm::sendTextToPlayer($args{actor}, sprintf("%-25.25s%d", "Total " .
#			$flagNames[$i] . " objects:", $flagCounts[$i]));
#	}
#}
}

sub rooms {
    my %args = @_;
    my ( $owner, $total, $rooms );
    $owner = NONE;
    if ( $args{text} ne "" ) {
        if ( substr( $arg, 0, 1 ) ne "#" ) {
            my ($n);
            $n = $arg1;
            $n =~ tr/A-Z/a-z/;
            if ( !exists( $main::playerIds{$n} ) ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "There is no such player." );
                return;
            }
            $owner = $main::playerIds{$n};
        }
        else {
            $owner = substr( $arg, 1 );
            $owner = &main::idBounds($owner);
        }
        if ( $owner == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That is not a valid player." );
            return;
        }
        if ( $main::objects[$owner]{"type"} != $player ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That is not a valid player." );
            return;
        }
    }
    $owner = $args{actor}
        if ( ( $owner == NONE )
        && ( !&Purl::tests::isWizard( $args{actor} ) ) );
    if (   ( $owner != $args{actor} )
        && ( !&Purl::tests::isWizard( $args{actor} ) ) )
    {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Only a wizard can list rooms belonging to other players." );
        return;
    }
    $total = 0;
    for ( $i = 0; ( $i <= $#objects ); $i++ ) {
        if ( $owner != NONE ) {
            next if ( $main::objects[$i]{"owner"} != $owner );
        }
        if ( $main::objects[$i]{"type"} == $room ) {
            $rooms .= ", " if ( $rooms ne "" );
            $rooms .= "#" . $i;
            $total++;
            if ( !( $total % 100 ) ) {

                # Flush for extreme cases
                Purl::comm::sendTextToPlayer( $args{actor}, $rooms );
                $rooms = "";
            }
        }
    }
    Purl::comm::sendTextToPlayer( $args{actor}, $rooms ) if ( $total % 100 );
    if ( $owner == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Total rooms: " . $total );
    }
    else {
        Purl::comm::sendTextToPlayer( $args{actor},
                  "Rooms belonging to "
                . $main::objects[$owner]{"name"} . ": "
                . $total );
    }
}

sub doing {
    my %args = @_;
    my $do = substr( $arg, 0, 39 );
    $main::objects[ $args{actor} ]{"doing"} = $do;
    my $msg = "Doing set.";
    if ( length $args{text} > 39 ) {
        my $diff = length $args{text} - 39;
        $msg .= " $diff characters lost.";
    }
    Purl::comm::sendTextToPlayer( actor => $args{actor}, text => $msg );
}

sub lookBody {
    my %args = @_;
    my ($id);
    if (( $args{text} eq "" )
        || ( $args{text} eq
            ( "#" . $main::objects[ $args{actor} ]{"location"} ) )
        )
    {
        describe( %args,
            target => $main::objects[ $args{actor} ]{"location"} );
    }
    else {
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $args{text} );
        $id = &findContents( $args{actor}, $args{text} )
            if ( $id == NONE );
        if ( $id == NONE ) {
            if ( $args{details} ) {
                if ( substr( $args{text}, 0, 1 ) eq "#" ) {
                    $id = int( substr( $args{text}, 1 ) );
                    $id = &main::idBounds($id);
                }
            }
        }
        if (   ( $id == NONE )
            || ( $main::objects[$id]{"type"} == NONE ) )
        {
            Purl::comm::sendTextToPlayer(
                target => $args{actor},
                text   => "I don't see that here."
            );
            return;
        }

        # print
        "DEBUG: lookBody - $args{actor} - $args{text} - $args{target}\n";

        describe( %args, target => $id );
    }
}

sub toad {
    %args = @_;
    my ( $id, $arg2id );
    if ( $arg1 eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Usage: \@toad player" );
        return;
    }
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        $id = int( substr( $arg1, 1 ) );
        $id = &main::idBounds($id);
        if ( $id == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "There is no such player." );
            return;
        }
    }
    else {
        my ($n);
        if ( $arg1 =~ /^\*(.*)$/ ) {
            $arg1 = $1;
        }
        $n = $arg1;
        $n =~ tr/A-Z/a-z/;
        if ( !exists( $main::playerIds{$n} ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "There is no such player." );
            return;
        }
        $id = $main::playerIds{$n};
    }
    if ( $arg2 eq "" ) {
        $arg2id = NONE;
    }
    else {
        if ( substr( $arg2, 0, 1 ) eq "#" ) {
            $arg2id = int( substr( $arg2, 1 ) );
            $arg2id = &main::idBounds($arg2id);
            if ( $arg2id == NONE ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "There is no such player." );
                return;
            }
        }
        else {
            my ($n);
            if ( $arg2 =~ /^\*(.*)$/ ) {
                $arg2 = $1;
            }
            $n = $arg2;
            $n =~ tr/A-Z/a-z/;
            if ( !exists( $main::playerIds{$n} ) ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "There is no such player." );
                return;
            }
            $arg2id = $main::playerIds{$n};
        }
        if ( $arg2id == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "I don't see that here." );
        }
    }
    if ( $arg2id != NONE ) {
        if ( $main::objects[$arg2id]{"type"} != $player ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "#" . $arg2id . " is not a player." );
            return;
        }
    }
    if ( !&Purl::tests::isWizard( $args{actor} ) ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Only a wizard can do that!" );
        return;
    }
    if ( $main::objects[$id]{"type"} != $player ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Not a player. \@toad is used to turn players into slimy toads (objects). \@recycle is used to eliminate objects."
        );
    }
    if ( $id == $arg2id ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You can't give a toad's possessions to the toad itself." );
        return;
    }
    if ( ( $id == 0 ) || ( $id == 1 ) ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Objects #0 and #1 are indestructible." );
        return;
    }

    &dropAll($id);

    &closePlayer($id) if ( $main::objects[$id]{"activeFd"} != NONE );
    my ($name) = $main::objects[$id]{"name"};
    $name =~ tr/A-Z/a-z/;
    undef( $main::playerIds{$name} );

    $main::objects[$id]{"name"}
        = "A slimy toad named " . $main::objects[$id]{"name"};
    $main::objects[$id]{"type"} = $thing;

#Find objects belonging to this player and give them to the specified player, or recycle them if no
#player is specified.

    my ($i);
    for ( $i = 0; ( $i <= $#objects ); $i++ ) {
        if ( ( $i != $id ) && ( $main::objects[$i]{"owner"} == $id ) ) {
            if ( $arg2id == NONE ) {
                &recycle( $args{actor}, "#" . $i, "", "" );
            }
            else {
                $main::objects[$i]{"owner"} = $arg2id;
            }
        }
    }
    Purl::comm::sendTextToPlayer( $args{actor}, "Toaded." );
    &updateApachePasswords;
}

sub twentyfour {
    %args = @_;
    $main::objects[ $args{actor} ]{"24hour"} = 1;
    Purl::comm::sendTextToPlayer( $args{actor}, "24-hour time display set." );
}

sub twelve {
    %args = @_;
    $main::objects[ $args{actor} ]{"24hour"} = 0;
    Purl::comm::sendTextToPlayer( $args{actor}, "12-hour time display set." );
}

sub tz {
    %args = @_;
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Usage: [-]HH:MM (optional minus sign, followed by an offset in hours and minutes)"
        );
        return;
    }
    if ( $args{text} =~ /^([-+]?)(\d\d?):(\d\d)$/ ) {
        my ( $sign, $hours, $mins ) = ( $1, $2, $3 );
        my ($tz) = $hours * 60 + $mins;
        $tz = -$tz if ( $sign eq "-" );
        $main::objects[ $args{actor} ]{"tz"} = $tz;
        Purl::comm::sendTextToPlayer( $args{actor}, "Time zone updated." );
    }
    else {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Usage: [-]HH:MM (optional minus sign, followed by an offset in hours and minutes)"
        );
    }
}

sub sex {
    %args = @_;
    if ( ( $arg1 eq "" ) || ( $arg2 eq "" ) ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Syntax: \@sex object = <gender>" );
        return;
    }
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    else {
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 );
        $id = &findContents( $args{actor}, $arg1 ) if ( $id == NONE );
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that object here." );
        return;
    }
    if (   ( !&Purl::tests::isWizard( $args{actor} ) )
        && ( $main::objects[$id]{"owner"} != $args{actor} ) )
    {
        Purl::comm::sendTextToPlayer( $args{actor}, "You don't own that." );
        return;
    }
    $main::objects[$id]{"sex"} = $arg2;
    Purl::comm::sendTextToPlayer( $args{actor}, "Gender set." );
}

sub set {
    %args = @_;
    my ( $flag, $id );
    ( $arg1, $arg2 ) = split( /=/, $arg, 2 );
    Purl::comm::sendTextToPlayer( $args{actor},
        "Syntax: \@set object = flag or !flag" )
        if ( ( $arg1 eq "" ) || ( $arg2 eq "" ) );
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    else {
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 );
        $id = &findContents( $args{actor}, $arg1 ) if ( $id == NONE );
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that object here." );
        return;
    }
    if (   ( !&Purl::tests::isWizard( $args{actor} ) )
        && ( $main::objects[$id]{"owner"} != $args{actor} ) )
    {
        Purl::comm::sendTextToPlayer( $args{actor}, "You don't own that." );
        return;
    }
    if ( substr( $arg2, 0, 1 ) eq "!" ) {
        if ( !$main::flags{ substr( $arg2, 1 ) } ) {
            Purl::comm::sendTextToPlayer( $args{actor}, "No such flag." );
            return;
        }
        $flag = $main::flags{ substr( $arg2, 1 ) }{"value"};
        if (   ( $flag == $main::flags{"wizard"}{"value"} )
            || ( $flag == $main::flags{"builder"}{"value"} ) )
        {
            if ( !&Purl::tests::isWizard( $args{actor} ) ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "Only a wizard can do that." );
                return;
            }
            if ( $id == 1 ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "Player #1 is always a wizard." );
                return;
            }
        }
        $main::objects[$id]{"flags"} &= ~$flag;
        Purl::comm::sendTextToPlayer( $args{actor}, "Flag cleared." );
    }
    else {
        if ( !$main::flags{$arg2} ) {
            Purl::comm::sendTextToPlayer( $args{actor}, "No such flag." );
            return;
        }
        $flag = $main::flags{$arg2};
        if (   ( $flag == $main::flags{"wizard"}{"value"} )
            || ( $flag == $main::flags{"builder"}{"value"} ) )
        {
            if ( !&Purl::tests::isWizard( $args{actor} ) ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "Only a wizard can do that." );
                return;
            }
            if ( $id == 1 ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "Player #1 is always a wizard." );
                return;
            }
        }
        $main::objects[$id]{"flags"} |= $flag;
        Purl::comm::sendTextToPlayer( $args{actor}, "Flag set." );
    }
}

sub recycle {
    %args = @_;
    my ($id);
    my ( @list, $e );
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Usage: \@recycle thing" );
        return;
    }
    $id = &findContents( $main::objects[ $args{actor} ]{"location"}, $arg );
    $id = &findContents( $args{actor}, $arg ) if ( $id == NONE );
    if ( $id == NONE ) {
        if ( substr( $arg, 0, 1 ) eq "#" ) {
            $id = int( substr( $arg, 1 ) );
            $id = &main::idBounds($id);
        }
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    &recycleById( $args{actor}, $id, 0 );
}

sub recycleById {
    my %args = @_;
    if ( $main::objects[$id]{"owner"} != $args{actor} ) {
        if ( !&Purl::tests::isWizard( $args{actor} ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "You don't own that!" )
                if ( !$quiet );
            return;
        }
    }
    if ( $main::objects[$id]{"type"} == $player ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You must \@toad players before recycling them." )
            if ( !$quiet );
        return;
    }
    if ( ( $id == 0 ) || ( $id == 1 ) ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Objects #0 and #1 are indestructible." )
            if ( !$quiet );
        return;
    }

    #Remove it from its location

    &removeContents( $main::objects[$id]{"location"}, $id );

    #Find all entrances and link them to the void
    my ($i);
    for ( $i = 0; ( $i <= $#objects ); $i++ ) {
        $main::objects[$i]{"action"} = 0
            if ( $main::objects[$i]{"action"} == $id );
    }

    #Reset the flags to keep anything funny like a puzzle
    #flag from interfering with the removal of the contents

    $main::objects[$id]{"flags"} = 0;

    #Send the contents home. If they live here,
    #recycle them too, unless they are players.
    #If they are players, set their homes to room 0
    #and send them home.

    @list = split( /,/, $main::objects[$id]{"contents"} );
    foreach $e (@list) {
        if ( $main::objects[$e]{"home"} == $id ) {
            if ( $main::objects[$e]{"type"} == $player ) {
                $main::objects[$e]{"home"} = 0;
            }
            else {
                &recycle( $args{actor}, "#" . $e, "", "" );
                next;
            }
        }
        &sendHome($e);
    }

    Purl::comm::sendTextToPlayer( $args{actor},
        $main::objects[$id]{"name"} . " recycled." )
        if ( !$quiet );

    #Mark it unused
    $main::objects[$id] = {};

    # I promise I won't introduce more of this stupidity
    $main::objects[$id]{"type"}     = NONE;
    $main::objects[$id]{"activeFd"} = NONE;
}

sub inventory {
    %args = @_;
    &describe( $args{actor}, $args{actor}, 1 );
}

sub drop {
    %args = @_;
    my ($id);
    if ( $args{text} eq "all" ) {
        &dropAll( $args{actor} );
        return;
    }
    $id = &findContents( $args{actor}, $arg );
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You are not carrying that." );
    }
    else {
        &removeContents( $args{actor}, $id );
        Purl::comm::sendTextToPlayer( $args{actor},
            "You dropped " . $main::objects[$id]{"name"} . "." );
        if ( $main::objects[$id]{"flags"} & $flags{"sticky"}{"value"} ) {
            &addContents( $main::objects[$id]{"home"}, $id );
        }
        else {
            &addContents( $main::objects[ $args{actor} ]{"location"}, $id );
        }
        if ( $main::objects[$id]{"odrop"} ne "" ) {
            &tellRoom(
                $main::objects[ $args{actor} ]{"location"},
                $args{actor},
                $main::objects[ $args{actor} ]{"name"} . " "
                    . &substitute( $args{actor},
                    $main::objects[$id]{"odrop"} )
            );
        }
        else {
            &tellRoom(
                $main::objects[ $args{actor} ]{"location"},
                $args{actor},
                $main::objects[ $args{actor} ]{"name"}
                    . " dropped "
                    . $main::objects[$id]{"name"} . "."
            );
        }
    }
}

sub get {
    %args = @_;
    my ($id);
    if ( $args{text} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Syntax: get thing" );
        return;
    }
    if ( $args{text} eq "me" ) {
        $id = $args{actor};
    }
    else {
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg );
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    else {
        if ( $id == $args{actor} ) {
            Purl::comm::sendTextToPlayer( $args{actor}, "How autoerotic." );
            return;
        }
        if (( !&testLock( $args{actor}, $id ) )
            || (   ( $main::objects[$id]{"type"} != $thing )
                && ( $main::objects[$id]{"type"} != $exit ) )
            )
        {
            &fail( $args{actor}, $id, "You can't pick that up!", "" );
            return;
        }
        if ( $main::objects[$id]{"type"} == $exit ) {
            if (   ( !&Purl::tests::isWizard( $args{actor} ) )
                && ( $main::objects[$id]{"owner"} != $args{actor} ) )
            {
                Purl::comm::sendTextToPlayer( $args{actor},
                    "You don't own that." );
                return;
            }
        }
        &removeContents( $main::objects[ $args{actor} ]{"location"}, $id );
        &addContents( $args{actor}, $id );
        &tellRoom(
            $main::objects[ $args{actor} ]{"location"},
            $args{actor},
            $main::objects[ $args{actor} ]{"name"} . " got "
                . $main::objects[$id]{"name"} . "."
        );
        &success( $args{actor}, $id,
            "You picked up " . $main::objects[$id]{"name"} . ".", "" );
    }
}

sub home {
    %args = @_;
    &sendHome( $args{actor} );
}

sub last {
    %args = @_;
    my ($id);
    if ( $arg1 eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor}, "Usage: last player" );
        return;
    }
    if ( substr( $arg1, 0, 1 ) eq "#" ) {
        $id = int( substr( $arg1, 1 ) );
        $id = &main::idBounds($id);
        if ( $id == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "There is no such player." );
            return;
        }
    }
    else {
        my ($n);
        if ( $arg1 =~ /^\*(.*)$/ ) {
            $arg1 = $1;
        }
        $n = $arg1;
        $n =~ tr/A-Z/a-z/;
        if ( !exists( $main::playerIds{$n} ) ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "There is no such player." );
            return;
        }
        $id = $main::playerIds{$n};
    }
    if ( $main::objects[ $args{actor} ]{"tz"} eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "You have not set your time zone. Assuming GMT. Use \@tz to change this."
        );
    }
    my ( $on, $off )
        = ( $main::objects[$id]{"on"}, $main::objects[$id]{"off"} );
    if ( $on eq "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            $main::objects[$id]{"name"} . " has never logged in." );
        return;
    }
    my ($msg) = $main::objects[$id]{"name"} . " last logged in: "
        . &Purl::filter::timeAndDateFormat( $args{actor},
        $main::objects[$id]{"on"} );
    Purl::comm::sendTextToPlayer( $args{actor}, $msg );
    if ( $main::objects[$id]{"activeFd"} != NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            $main::objects[$id]{"name"} . " is still logged in." );
    }
    elsif ( $off eq "" ) {
        return;
    }
    elsif ( $off > $on ) {
        Purl::comm::sendTextToPlayer(
            $args{actor},
            $main::objects[$id]{"name"} . " last logged out: "
                . &Purl::filter::timeAndDateFormat(
                $args{actor}, $main::objects[$id]{"off"}
                )
        );
    }
    else {

        # If $on is less than $off, the mud was stopped
        # before they logged off, so logoff time is indeterminate.
    }
}

sub alias {
    %args = @_;
    if ( substr( $arg1, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $arg1 );
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 )
            if ( $id == NONE );
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    else {
        if (   ( $main::objects[$id]{"owner"} != $args{actor} )
            && ( !&Purl::tests::isWizard( $args{actor} ) ) )
        {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That doesn't belong to you!" );
        }
        else {
            if (( $main::objects[$id]{"type"} == $player )
                || ( $main::objects[$id]{"flags"}
                    & $flags{"creature"}{"value"} )
                )
            {
                my $n = $arg2;
                $n =~ tr/A-Z/a-z/;
                $n =~ s/\s+//g;
                if ( exists( $main::playerIds{$n} ) ) {
                    Purl::comm::sendTextToPlayer( $args{actor},
                        "That name is already taken." );
                    return;
                }
                $main::playerIds{$n} = $id;
            }
            $main::objects[$id]{"alias"} = $arg2;
            Purl::comm::sendTextToPlayer( $args{actor}, "Alias set." );
        }
    }
}

sub name {
    %args = @_;
    if ( substr( $arg1, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $arg1 );
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 )
            if ( $id == NONE );
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    else {
        if (   ( $main::objects[$id]{"owner"} != $args{actor} )
            && ( !&Purl::tests::isWizard( $args{actor} ) ) )
        {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That doesn't belong to you!" );
        }
        else {
            if ( $main::objects[$id]{"type"} == $player ) {
                my $n = $arg2;
                $n =~ tr/A-Z/a-z/;
                $n =~ s/\s+//g;
                if ( exists( $main::playerIds{$n} )
                    && ( $args{actor} != $id ) )
                {
                    Purl::comm::sendTextToPlayer( $args{actor},
                        "That name is already taken." );
                    return;
                }
                my $n2 = $main::objects[$id]{"name"};
                $n2 =~ tr/A-Z/a-z/;
                undef( $main::playerIds{$n2} );
                $main::playerIds{$n} = $id;
            }
            $main::objects[$id]{"name"} = $arg2;
            Purl::comm::sendTextToPlayer( $args{actor}, "Name set." );
        }
    }
}

sub chown {
    %args = @_;
    if ( substr( $arg1, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $arg1 );
        if ( $id == NONE ) {
            $id = &findContents( $main::objects[ $args{actor} ]{"location"},
                $arg1 );
        }
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return;
    }
    elsif ( $main::objects[$id]{"type"} == $player ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "Players always own themselves." );
        return;
    }
    else {
        if (   ( $main::objects[$id]{"owner"} != $args{actor} )
            && ( !&Purl::tests::isWizard( $args{actor} ) )
            && !( $main::objects[$id]{"flags"} & $flags{"chownok"}{"value"} )
            )
        {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That doesn't belong to you!" );
        }
        else {
            my ($arg2Id);
            if ( substr( $arg2, 0, 1 ) eq '#' ) {
                $arg2Id = substr( $arg2, 1 );
            }
            else {
                my $n = $arg2;
                if ( $n eq "me" ) {
                    $arg2Id = $args{actor};
                }
                else {
                    $n =~ tr/A-Z/a-z/;
                    $arg2Id = $main::playerIds{$n};
                }
            }
            if ( $main::objects[$arg2Id]{"type"} != $player ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    $arg2 . " is not a valid player." );
                return;
            }
            $main::objects[$id]{"owner"} = $arg2Id;
            Purl::comm::sendTextToPlayer( $args{actor}, "Owner set." );
            Purl::comm::sendTextToPlayer( $arg2Id,
                      $main::objects[ $args{actor} ]{"name"}
                    . " has given you #$id ("
                    . $main::objects[$id]{"name"}
                    . ")." )
                unless ( $arg4Id == $args{actor} );
        }
    }
}

sub dropAll {
    my ($container) = @_;
    my (@list);
    @list = split( /,/, $main::objects[$container]{"contents"} );
    foreach my $e (@list) {
        &command( $container, "drop #" . $e );
    }
    Purl::comm::sendTextToPlayer( $container,
        "You are not carrying anything." )
        if ( !int(@list) );
}

sub sendHome {
    my %args = @_;
    &dropAll( $args{actor} )
        if (
        $main::objects[ $main::objects[ $args{actor} ]{"location"} ]{"flags"}
        & $flags{"puzzle"}{"value"} );
    &removeContents( $main::objects[ $args{actor} ]{"location"},
        $args{actor} );
    &tellRoom( $main::objects[ $args{actor} ]{"location"},
        NONE, $main::objects[ $args{actor} ]{"name"} . " goes home." )
        if (
        !(  $main::objects[ $main::objects[$id]{"location"} ]{"flags"}
            & $flags{"grand"}{"value"}
        )
        );
    &addContents( $main::objects[ $args{actor} ]{"home"}, $args{actor} );
    &tellRoom( $main::objects[ $args{actor} ]{"location"},
        $args{actor},
        $main::objects[ $args{actor} ]{"name"} . " arrives at home." )
        if (
        !(  $main::objects[ $main::objects[$id]{"location"} ]{"flags"}
            & $flags{"grand"}{"value"}
        )
        );
    Purl::comm::sendTextToPlayer( $args{actor}, "You go home." );
    &look( $args{actor}, "", "", "" );
}

sub setField {
    %args = @_;
    my ($id);
    if ( substr( $arg1, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $arg1 );
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $arg1 )
            if ( $id == NONE );
    }
    else {
        $id = substr( $arg1, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == NONE ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            "I don't see that here." );
        return NONE;
    }
    else {
        if (   ( $main::objects[$id]{"owner"} != $args{actor} )
            && ( !&Purl::tests::isWizard( $args{actor} ) ) )
        {
            Purl::comm::sendTextToPlayer( $args{actor},
                "That doesn't belong to you!" );
            return NONE;
        }
        else {
            $main::objects[$id]{$field} = $arg2;
            if ( $arg2 eq "" ) {
                Purl::comm::sendTextToPlayer( $args{actor},
                    $name . " cleared." );
            }
            else {
                Purl::comm::sendTextToPlayer( $args{actor}, $name . " set." );
            }
        }
    }
    return $id;
}

sub getIdsSpokenTo {
    my %args = @_;
    my (@refs) = split( /,/, $arg1 );
    my ( @ids, $i );
    for $i (@refs) {
        $i = &Purl::filter::canonicalizeWord( $args{actor}, $i );
        if ( $i =~ /^#(.*)/ ) {
            $id = &main::idBounds($1);
        }
        else {
            $i =~ tr/A-Z/a-z/;
            if ( !exists( $main::playerIds{$i} ) ) {
                $id = &findContents(
                    $main::objects[ $args{actor} ]{"location"},
                    $i, $player );
                if ( $id == NONE ) {
                    Purl::comm::sendTextToPlayer( $args{actor},
                        "Sorry, there is no player named $i.\n" );
                    next;
                }
            }
            else {
                $id = $main::playerIds{$i};
            }
        }
        if ( $main::objects[$id]{"activeFd"} == NONE ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "$i is not logged in." );
            next;
        }
        if ( $main::objects[$id]{"type"} != $player ) {
            Purl::comm::sendTextToPlayer( $args{actor},
                "$i is an inanimate object." );
            next;
        }
        push @ids, $id;
    }
    return @ids;
}

sub setLock {
    %args = @_;
    my ($id);
    $id = &setField( $args{actor}, $arg, $arg1, $arg2, "lock", "Lock" );
    return if ( $id == NONE );

    # Canonicalize the lock now, not when the lock is tested
    my ( $lock, $i, $word, $expr, $len, @words, $c );
    $lock = $main::objects[$id]{"lock"};
    $word = "";
    $expr = "";
    $len  = length($lock);
    for ( $i = 0; ( $i < $len ); $i++ ) {
        $_ = $c = substr( $lock, $i, 1 );
        if (/[\(\)\&\|\!]/) {
            if ( $word ne "" ) {
                $word = &visibleCanonicalizeWord( $args{actor}, $word );
                $expr .= $word;
            }
            $expr .= $c;
            $word = "";
        }
        else {
            $word .= $c;
        }
    }
    $expr .= &visibleCanonicalizeWord( $args{actor}, $word )
        if ( $word ne "" );
    $main::objects[$id]{"lock"} = $expr;
}

sub setDescription {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "description",
        "Description" );
}

sub setFail {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "fail", "Fail" );
}

sub setOfail {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "ofail", "Ofail" );
}

sub setOdrop {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "odrop", "Odrop" );
}

sub setSuccess {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "success", "Success" );
}

sub setOsuccess {
    %args = @_;
    &setField( $args{actor}, $arg, $arg1, $arg2, "osuccess", "Osuccess" );
}

sub success {
    my %args = @_;
    if ( $main::objects[$id]{"success"} ne "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            &substitute( $args{actor}, $main::objects[$id]{"success"} ) );
    }
    else {
        Purl::comm::sendTextToPlayer( $args{actor}, $default )
            if ( $default ne "" );
    }
    if ( $main::objects[$id]{"osuccess"} ne "" ) {
        &tellRoom(
            $main::objects[ $args{actor} ]{"location"},
            $args{actor},
            $main::objects[ $args{actor} ]{"name"} . " "
                . &substitute( $args{actor}, $main::objects[$id]{"osuccess"} )
        );
    }
    else {
        &tellRoom( $main::objects[ $args{actor} ]{"location"},
            $args{actor}, $odefault )
            if ( $odefault ne "" );
    }
}

sub fail {
    my %args = @_;
    if ( $main::objects[$id]{"fail"} ne "" ) {
        Purl::comm::sendTextToPlayer( $args{actor},
            &substitute( $args{actor}, $main::objects[$id]{"fail"} ) );
    }
    else {
        Purl::comm::sendTextToPlayer( $args{actor}, $default )
            if ( $default ne "" );
    }
    if ( $main::objects[$id]{"ofail"} ne "" ) {
        &tellRoom(
            $main::objects[ $args{actor} ]{"location"},
            $args{actor},
            $main::objects[ $args{actor} ]{"name"} . " "
                . &substitute( $args{actor}, $main::objects[$id]{"ofail"} )
        );
    }
    else {
        &tellRoom( $main::objects[ $args{actor} ]{"location"},
            $args{actor}, $odefault )
            if ( $odefault ne "" );
    }
}

sub debug {
    %args = @_;
    my $target = $arg;
    $target =~ s/#//g;
    Purl::comm::sendTextToPlayer( $args{actor},
        "DEBUG ON $main::objects[$target]{'name'}" );
    foreach my $key ( sort keys %{ $main::objects[$target] } ) {
        my $string = $key . ": " . $main::objects[$target]{$key};
        Purl::comm::sendTextToPlayer( $args{actor}, $string );
    }
}

1;
